home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch10 / FlakeAn1.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-08  |  8KB  |  246 lines
  1. VERSION 5.00
  2. Begin VB.Form frmFlakeAn1 
  3.    Caption         =   "FlakeAn1"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   900
  7.    ClientWidth     =   5070
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4335
  11.    ScaleWidth      =   5070
  12.    Begin VB.TextBox txtTheta 
  13.       Height          =   285
  14.       Left            =   600
  15.       MaxLength       =   3
  16.       TabIndex        =   1
  17.       Text            =   "60"
  18.       Top             =   360
  19.       Width           =   375
  20.    End
  21.    Begin VB.TextBox txtDepth 
  22.       Height          =   285
  23.       Left            =   600
  24.       MaxLength       =   3
  25.       TabIndex        =   0
  26.       Text            =   "3"
  27.       Top             =   0
  28.       Width           =   375
  29.    End
  30.    Begin VB.PictureBox picCanvas 
  31.       AutoRedraw      =   -1  'True
  32.       Height          =   4335
  33.       Left            =   1080
  34.       ScaleHeight     =   285
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   261
  37.       TabIndex        =   4
  38.       Top             =   0
  39.       Width           =   3975
  40.    End
  41.    Begin VB.CommandButton cmdGo 
  42.       Caption         =   "Go"
  43.       Default         =   -1  'True
  44.       Height          =   375
  45.       Left            =   240
  46.       TabIndex        =   2
  47.       Top             =   840
  48.       Width           =   615
  49.    End
  50.    Begin VB.Label Label1 
  51.       Caption         =   "Theta"
  52.       Height          =   255
  53.       Index           =   1
  54.       Left            =   0
  55.       TabIndex        =   5
  56.       Top             =   360
  57.       Width           =   495
  58.    End
  59.    Begin VB.Label Label1 
  60.       Caption         =   "Depth"
  61.       Height          =   255
  62.       Index           =   0
  63.       Left            =   0
  64.       TabIndex        =   3
  65.       Top             =   0
  66.       Width           =   495
  67.    End
  68. Attribute VB_Name = "frmFlakeAn1"
  69. Attribute VB_GlobalNameSpace = False
  70. Attribute VB_Creatable = False
  71. Attribute VB_PredeclaredId = True
  72. Attribute VB_Exposed = False
  73. Option Explicit
  74. Private Const PI = 3.14159
  75. ' Coordinates of the points in the initiator.
  76. Private Const NUM_INITIATOR_POINTS = 3
  77. Private InitiatorX(0 To NUM_INITIATOR_POINTS) As Single
  78. Private InitiatorY(0 To NUM_INITIATOR_POINTS) As Single
  79. ' Angles and distances for the generator.
  80. Private Const NUM_GENERATOR_ANGLES = 4
  81. Private ScaleFactor As Single
  82. Private GeneratorDTheta(1 To NUM_GENERATOR_ANGLES) As Single
  83. ' Draw the complete snowflake.
  84. Private Sub DrawFlake(ByVal depth As Integer, ByVal length As Single, ByVal offset As Single)
  85. Dim i As Integer
  86. Dim x1 As Single
  87. Dim y1 As Single
  88. Dim x2 As Single
  89. Dim y2 As Single
  90. Dim dx As Single
  91. Dim dy As Single
  92. Dim theta As Single
  93.     picCanvas.Cls
  94.     ' Draw the snowflake.
  95.     For i = 1 To NUM_INITIATOR_POINTS
  96.         x1 = InitiatorX(i - 1)
  97.         y1 = InitiatorY(i - 1)
  98.         x2 = InitiatorX(i)
  99.         y2 = InitiatorY(i)
  100.         dx = x2 - x1
  101.         dy = y2 - y1
  102.         theta = ATan2(dy, dx)
  103.         DrawFlakeEdge depth, x1, y1, _
  104.             theta, length, offset
  105.     Next i
  106. End Sub
  107. ' Draw the animation frames.
  108. Private Sub MakeMovie(ByVal depth As Integer, ByVal length As Single)
  109. Const FRAMES_PER_DEPTH = 20
  110. Const MS_PER_FRAME = 50
  111. Dim i As Integer
  112. Dim max_depth As Integer
  113. Dim offset As Single
  114. Dim doffset As Single
  115. Dim next_time As Long
  116.     ' Draw the animation frames.
  117.     max_depth = depth
  118.     next_time = GetTickCount()
  119.     For depth = 1 To max_depth
  120.         doffset = length * ScaleFactor ^ depth * _
  121.             Sin(GeneratorDTheta(2)) / FRAMES_PER_DEPTH
  122.         offset = doffset
  123.         For i = 1 To FRAMES_PER_DEPTH
  124.             WaitTill next_time
  125.             DrawFlake depth, length, offset
  126.             DoEvents
  127.             offset = offset + doffset
  128.             next_time = next_time + MS_PER_FRAME
  129.         Next i
  130.     Next depth
  131. End Sub
  132. Private Sub CmdGo_Click()
  133. Dim depth As Integer
  134. Dim length As Single
  135. Dim theta As Single
  136. Dim unit As Single
  137. Dim vunit As Single
  138. Dim hunit As Single
  139.     picCanvas.Cls
  140.     MousePointer = vbHourglass
  141.     DoEvents
  142.     ' Get the parameters.
  143.     If Not IsNumeric(txtDepth.Text) Then txtDepth.Text = "5"
  144.     depth = CInt(txtDepth.Text)
  145.     ' Initialize the generator.
  146.     If Not IsNumeric(txtTheta.Text) Then txtTheta.Text = "60"
  147.     theta = CInt(txtTheta.Text) / 180 * PI
  148.     ' See how big we can make the curve.
  149.     vunit = 0.9 * picCanvas.ScaleHeight / (Sqr(3) * 4 / 3)
  150.     hunit = 0.9 * picCanvas.ScaleWidth / 2
  151.     If vunit < hunit Then
  152.         unit = vunit
  153.     Else
  154.         unit = hunit
  155.     End If
  156.     length = 2 * unit
  157.     ' Initialize the generator and initiator.
  158.     InitializeGenerator theta, length
  159.     ' Draw the animation frames.
  160.     MakeMovie depth, length
  161.     MousePointer = vbDefault
  162.     Beep
  163. End Sub
  164. ' Initialize the generator for the indicated angle.
  165. Private Sub InitializeGenerator(ByVal theta As Single, ByVal length As Single)
  166. Dim xmid As Single
  167. Dim ymid As Single
  168.     ' Initialize the initiator's coordinates.
  169.     xmid = picCanvas.ScaleWidth / 2
  170.     ymid = picCanvas.ScaleHeight / 2
  171.     InitiatorX(1) = xmid + length / 2
  172.     InitiatorY(1) = ymid - length / 2 * Sqr(3) / 3
  173.     InitiatorX(2) = xmid - length / 2
  174.     InitiatorY(2) = InitiatorY(1)
  175.     InitiatorX(3) = xmid
  176.     InitiatorY(3) = ymid + length / 2 * Sqr(3) * 2 / 3
  177.     InitiatorX(0) = InitiatorX(3)
  178.     InitiatorY(0) = InitiatorY(3)
  179.     ScaleFactor = 1 / (2 * (1 + Cos(theta)))
  180.     GeneratorDTheta(1) = 0
  181.     GeneratorDTheta(2) = theta
  182.     GeneratorDTheta(3) = -2 * theta
  183.     GeneratorDTheta(4) = theta
  184. End Sub
  185. ' Recursively draw a snowflake edge starting at
  186. ' (x1, y1) in direction theta and distance dist.
  187. ' Leave the coordinates of the endpoint in
  188. ' (x1, y1).
  189. Private Sub DrawFlakeEdge(ByVal depth As Integer, ByRef x1 As Single, ByRef y1 As Single, ByVal theta As Single, ByVal dist As Single, ByVal offset As Single)
  190. Dim status As Integer
  191. Dim i As Integer
  192. Dim x2 As Single
  193. Dim y2 As Single
  194. Dim new_theta As Single
  195. Dim dtheta As Single
  196. Dim hyp As Single
  197. Dim adj As Single
  198.     If depth <= 1 Then
  199.         ' Draw the final depth.
  200.         dist = dist * ScaleFactor
  201.         adj = dist * Cos(GeneratorDTheta(2))
  202.         hyp = Sqr(adj * adj + offset * offset)
  203.         x2 = x1 + dist * Cos(theta)
  204.         y2 = y1 + dist * Sin(theta)
  205.         picCanvas.Line (x1, y1)-(x2, y2)
  206.         x1 = x2
  207.         y1 = y2
  208.         
  209.         dtheta = ATan2(offset, adj)
  210.         new_theta = theta + dtheta
  211.         x2 = x1 + hyp * Cos(new_theta)
  212.         y2 = y1 + hyp * Sin(new_theta)
  213.         picCanvas.Line (x1, y1)-(x2, y2)
  214.         x1 = x2
  215.         y1 = y2
  216.         
  217.         new_theta = theta - dtheta
  218.         x2 = x1 + hyp * Cos(new_theta)
  219.         y2 = y1 + hyp * Sin(new_theta)
  220.         picCanvas.Line (x1, y1)-(x2, y2)
  221.         x1 = x2
  222.         y1 = y2
  223.         
  224.         x2 = x1 + dist * Cos(theta)
  225.         y2 = y1 + dist * Sin(theta)
  226.         picCanvas.Line (x1, y1)-(x2, y2)
  227.         x1 = x2
  228.         y1 = y2
  229.         
  230.         Exit Sub
  231.     End If
  232.     ' Recursively draw the edge.
  233.     dist = dist * ScaleFactor
  234.     For i = 1 To NUM_GENERATOR_ANGLES
  235.         theta = theta + GeneratorDTheta(i)
  236.         DrawFlakeEdge depth - 1, x1, y1, theta, dist, offset
  237.     Next i
  238. End Sub
  239. Private Sub Form_Resize()
  240. Dim wid As Single
  241.     ' Make the picCanvas as big as possible.
  242.     wid = ScaleWidth - picCanvas.Left
  243.     If wid < 120 Then wid = 120
  244.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  245. End Sub
  246.